home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
TeX 1995 July
/
TeX CD-ROM July 1995 (Disc 1)(Walnut Creek)(1995).ISO
/
dviware
/
dvitovdu32
/
src
/
pascal
/
options.p
< prev
next >
Wrap
Text File
|
1991-11-10
|
12KB
|
351 lines
(* This module initializes the DVI file parameter and command line options.
Highly SYSDEP!
*)
#include 'globals.h';
#include 'screenio.h';
#include 'options.h';
TYPE
units = (ic,cm,mm,pc,pt,px);
VAR
option : CHAR; (* current command option *)
value : string; (* current option's value *)
vlength : INTEGER; (* current value's length *)
argnum : INTEGER; (* 0..argc-1; used in argv calls *)
FUNCTION sscanf (VAR s, format : string; VAR r : real) : integer;
EXTERNAL;
(******************************************************************************)
FUNCTION Cap (ch : CHAR) : CHAR;
(* If ch is in 'a'..'z' then return capitalized letter else return ch. *)
BEGIN
IF (ch < 'a') OR (ch > 'z') THEN Cap := ch ELSE Cap := CHR(ORD(ch) - 32);
END; (* Cap *)
(******************************************************************************)
FUNCTION Len (str : string) : INTEGER;
(* Return length of given string. *)
LABEL 888;
VAR i : INTEGER;
BEGIN
i := maxstring;
WHILE i > 0 DO BEGIN
IF str[i-1] <> ' ' THEN goto 888;
i := i - 1;
END;
888:
Len := i;
END; (* Len *)
(******************************************************************************)
FUNCTION ExplicitExt (fname : string; len : INTEGER) : BOOLEAN;
(* SYSDEP: Check for an extension of the form ".*" where * is any string
not containing "/". len is length of fname.
If "." found then TRUE is returned, otherwise FALSE.
*)
LABEL 999;
BEGIN
WHILE len > 0 DO BEGIN (* search backwards looking for . *)
len := len - 1;
IF fname[len] = '/' THEN BEGIN (* handle file names like ../myfiles/foo *)
ExplicitExt := FALSE;
goto 999;
END
ELSE IF fname[len] = '.' THEN BEGIN
ExplicitExt := TRUE;
goto 999;
END;
END;
ExplicitExt := FALSE;
999:
END; (* ExplicitExt *)
(******************************************************************************)
PROCEDURE GetValue;
(* Get parameter following current option and store in value. *)
VAR i : integer;
BEGIN
IF vlength > 2 THEN BEGIN (* allow things like -m1000 *)
FOR i := 0 TO vlength - 1 DO
value[i] := value[i+2]; (* shift value left 2 places *)
vlength := vlength - 2;
END
ELSE BEGIN
(* option should be followed by value *)
value := ' ';
IF argnum < argc THEN argv(argnum,value);
vlength := Len(value); (* 0 if no more args *)
argnum := argnum + 1;
IF vlength <= 0 THEN BEGIN
WriteString('Missing value after -'); WriteChar(option); WriteLine;
RestoreTerminal; exit(1);
END;
END;
END; (* GetValue *)
(******************************************************************************)
PROCEDURE GetCardinal (VAR n : INTEGER);
(* If current value represents a positive integer then return via n. *)
VAR result : integer; r : real; fmt : string;
BEGIN
fmt := '%f';
result := sscanf(value,fmt,r);
n := trunc(r + 0.5);
(* result can be 1 or -1 if ok! *)
IF (ABS(result) <> 1) OR (n <= 0) THEN BEGIN
WriteString('Bad -'); WriteChar(option);
WriteString(' value:'); WriteChar(' '); WriteString(value); WriteLine;
WriteString('Specify a positive integer.'); WriteLine;
RestoreTerminal; exit(1);
END;
END; (* GetCardinal *)
(******************************************************************************)
PROCEDURE GetPosDimen (VAR r : REAL; VAR un : units);
(* A valid +ve dimension consists of a positive integer or real number followed
by a two-letter unit: cm, mm, in, pc, pt or px (or in uppercase).
If current value represents a valid dimension, we return number part in r
and units part in un.
*)
VAR i, result : INTEGER; ch1, ch2 : CHAR; fmt : string;
BEGIN
(* extract un *)
IF vlength > 1 THEN i := vlength-1 ELSE i := 1;
IF (Cap(value[i-1]) = 'I') AND (Cap(value[i]) = 'N') THEN
un := ic
ELSE IF (Cap(value[i-1]) = 'C') AND (Cap(value[i]) = 'M') THEN
un := cm
ELSE IF (Cap(value[i-1]) = 'M') AND (Cap(value[i]) = 'M') THEN
un := mm
ELSE IF (Cap(value[i-1]) = 'P') AND (Cap(value[i]) = 'C') THEN
un := pc
ELSE IF (Cap(value[i-1]) = 'P') AND (Cap(value[i]) = 'T') THEN
un := pt
ELSE IF (Cap(value[i-1]) = 'P') AND (Cap(value[i]) = 'X') THEN
un := px
ELSE BEGIN
WriteString('Bad units in -'); WriteChar(option);
WriteString(' value:'); WriteChar(' '); WriteString(value); WriteLine;
WriteString('Last two letters should be cm, mm, in, pc, pt or px.');
WriteLine; RestoreTerminal; exit(1);
END;
ch1 := value[i-1]; (* remember letters in units *)
ch2 := value[i];
value[i] := ' '; (* remove units *)
value[i-1] := ' ';
fmt := '%f';
result := sscanf(value,fmt,r);
(* result can be 1 or -1 if ok! *)
IF (ABS(result) <> 1) OR (r <= 0.0) THEN BEGIN
value[i-1] := ch1; (* restore units *)
value[i] := ch2;
WriteString('Bad -'); WriteChar(option);
WriteString(' value:'); WriteChar(' '); WriteString(value); WriteLine;
WriteString('Specify a positive dimension.'); WriteLine;
RestoreTerminal; exit(1);
END;
END; (* GetPosDimen *)
(******************************************************************************)
PROCEDURE GetDimen (VAR r : REAL; VAR un : units);
(* A valid dimension consists of an integer or real number followed
by a two-letter unit: cm, mm, in, pc, pt or px (or in uppercase).
If current value represents a valid dimension, we return number part in r
and units part in un.
*)
VAR i, result : INTEGER; ch1, ch2 : CHAR; fmt : string;
BEGIN
(* extract un *)
IF vlength > 1 THEN i := vlength-1 ELSE i := 1;
IF (Cap(value[i-1]) = 'I') AND (Cap(value[i]) = 'N') THEN
un := ic
ELSE IF (Cap(value[i-1]) = 'C') AND (Cap(value[i]) = 'M') THEN
un := cm
ELSE IF (Cap(value[i-1]) = 'M') AND (Cap(value[i]) = 'M') THEN
un := mm
ELSE IF (Cap(value[i-1]) = 'P') AND (Cap(value[i]) = 'C') THEN
un := pc
ELSE IF (Cap(value[i-1]) = 'P') AND (Cap(value[i]) = 'T') THEN
un := pt
ELSE IF (Cap(value[i-1]) = 'P') AND (Cap(value[i]) = 'X') THEN
un := px
ELSE BEGIN
WriteString('Bad units in -'); WriteChar(option);
WriteString(' value:'); WriteChar(' '); WriteString(value); WriteLine;
WriteString('Last two letters should be cm, mm, in, pc, pt or px.');
WriteLine; RestoreTerminal; exit(1);
END;
ch1 := value[i-1]; (* remember letters in units *)
ch2 := value[i];
value[i] := ' '; (* remove units *)
value[i-1] := ' ';
fmt := '%f';
result := sscanf(value,fmt,r);
(* result can be 1 or -1 if ok! *)
IF (ABS(result) <> 1) THEN BEGIN
value[i-1] := ch1; (* restore units *)
value[i] := ch2;
WriteString('Bad -'); WriteChar(option);
WriteString(' value:'); WriteChar(' '); WriteString(value); WriteLine;
WriteString('Specify a dimension.'); WriteLine;
RestoreTerminal; exit(1);
END;
END; (* GetDimen *)
(******************************************************************************)
FUNCTION DimenPixels (r : REAL; u : units) : INTEGER;
(* Return given dimension in terms of pixels. *)
BEGIN
CASE u OF
ic : DimenPixels := TRUNC(r * resolution + 0.5);
cm : DimenPixels := TRUNC((r / 2.54) * resolution + 0.5);
mm : DimenPixels := TRUNC((r / 25.4) * resolution + 0.5);
pt : DimenPixels := TRUNC((r / 72.27) * resolution + 0.5);
pc : DimenPixels := TRUNC((r / 72.27) * 12.0 * resolution + 0.5);
px : DimenPixels := TRUNC(r + 0.5)
END;
END; (* DimenPixels *)
(******************************************************************************)
PROCEDURE InitOptions;
(* Get DVI file and any options from command line.
If an option appears more than once then we return the last value.
*)
VAR
hoffu, voffu, xu, yu : units;
hoffr, voffr, xr, yr : REAL;
landscape : boolean;
temp, strlen, i : integer;
str : string;
BEGIN
(* initialize option values with defaults; note that the dv script can
set up different defaults
*)
resolution := 300; (* LaserWriter resolution *)
hoffu := ic;
voffu := ic;
hoffr := 0.0; (* no margin shifting *)
voffr := 0.0;
xu := ic; (* paper dimensions in inches *)
yu := ic;
xr := 8.3; (* A4 paper is 8.3" wide *)
yr := 11.7; (* A4 paper is 11.7" high *)
mag := 0; (* use DVI mag *)
vdu := 'TERM'; (* SYSDEP: default; see dv *)
fontdir := '/tex/pk/'; (* location of PK files *)
dummyfont := 'cmr10.300pk'; (* typical font *)
tfmdir := '/tex/fonts/'; (* location of PS TFM files *)
psprefix := 'ps-'; (* prefix in PS font names *)
helpname := '/tex/dvitovdu.hlp'; (* file read by ? command *)
DVIname := ' '; (* SYSDEP: empty string *)
landscape := FALSE; (* don't swap -x and -y values *)
argnum := 1;
WHILE argnum < argc DO BEGIN
value := ' ';
argv(argnum,value);
vlength := Len(value);
argnum := argnum + 1;
IF value[0] = '-' THEN BEGIN
IF vlength > 1 THEN option := value[1] ELSE option := ' ';
CASE option OF
'r' : BEGIN GetValue; GetCardinal(resolution); END;
'm' : BEGIN GetValue; GetCardinal(mag); END;
'x' : BEGIN GetValue; GetPosDimen(xr,xu); END;
'y' : BEGIN GetValue; GetPosDimen(yr,yu); END;
'H' : BEGIN GetValue; GetDimen(hoffr,hoffu); END;
'V' : BEGIN GetValue; GetDimen(voffr,voffu); END;
'v' : BEGIN GetValue; vdu := value; END;
't' : BEGIN GetValue; tfmdir := value; END;
'p' : BEGIN GetValue; psprefix := value; END;
'f' : BEGIN GetValue; fontdir := value; END;
'd' : BEGIN GetValue; dummyfont := value; END;
'h' : BEGIN GetValue; helpname := value; END;
(* bad string values will be detected in other modules *)
'l' : landscape := TRUE;
OTHERWISE
WriteString('Unknown option: -'); WriteChar(option); WriteLine;
RestoreTerminal; exit(1);
END;
END
ELSE BEGIN
(* value doesn't start with '-', so assume it is DVI file *)
DVIname := value;
IF NOT ExplicitExt(DVIname,vlength) THEN (* append .dvi *)
IF vlength + 3 < maxstring THEN BEGIN
DVIname[vlength] := '.';
DVIname[vlength+1] := 'd';
DVIname[vlength+2] := 'v';
DVIname[vlength+3] := 'i';
END
ELSE BEGIN (* user has given a mighty long file name *)
WriteString('DVI file name too long:'); WriteChar(' ');
WriteString(DVIname); WriteLine;
RestoreTerminal; exit(1);
END;
(* bad DVIname will be detected upon open in main module *)
END;
END;
IF DVIname[0] = ' ' THEN BEGIN (* no file name on command line *)
WriteString('DVI file not given!'); WriteLine;
RestoreTerminal; exit(1);
END;
(* prepend fontdir to dummyfont *)
str := fontdir;
strlen := Len(fontdir);
FOR i := 1 TO Len(dummyfont) DO BEGIN
IF strlen < maxstring THEN BEGIN
str[strlen] := dummyfont[i-1];
strlen := strlen + 1;
END;
END;
dummyfont := str;
(* set h/voffset and paperwd/ht only after resolution has been decided *)
hoffset := DimenPixels(hoffr,hoffu);
voffset := DimenPixels(voffr,voffu);
paperwd := DimenPixels(xr,xu);
paperht := DimenPixels(yr,yu);
IF landscape THEN BEGIN (* swap paperwd and paperht *)
temp := paperwd;
paperwd := paperht;
paperht := temp;
END;
END; (* InitOptions *)